home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / xlisp-1.6 / queens.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-06  |  2.6 KB  |  71 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         queens.lsp
  5. ; RCS:          $Header: $
  6. ; Description:  Place n queens on a board --See Winston and Horn Ch. 11
  7. ;        Usage:
  8. ;            (queens <n>)
  9. ;        where <n> is an integer -- the size of the board - try (queens 4)
  10. ; Author:       Winston and Horn
  11. ; Created:      Sat Oct  5 21:01:22 1991
  12. ; Modified:     Sat Oct  5 21:02:07 1991 (Niels Mayer) mayer@hplnpm
  13. ; Language:     Lisp
  14. ; Package:      N/A
  15. ; Status:       X11r5 contrib tape release
  16. ;
  17. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  18. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  19. ;
  20. ; Permission to use, copy, modify, distribute, and sell this software and its
  21. ; documentation for any purpose is hereby granted without fee, provided that
  22. ; the above copyright notice appear in all copies and that both that
  23. ; copyright notice and this permission notice appear in supporting
  24. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  25. ; used in advertising or publicity pertaining to distribution of the software
  26. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  27. ; makes no representations about the suitability of this software for any
  28. ; purpose.  It is provided "as is" without express or implied warranty.
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30.  
  31. (defun cadar (x)
  32.   (car (cdr (car x))))
  33.  
  34. ; Do two queens threaten each other ?
  35. (defun threat (i j a b)
  36.   (or (equal i a)            ;Same row
  37.       (equal j b)            ;Same column
  38.       (equal (- i j) (- a b))        ;One diag.
  39.       (equal (+ i j) (+ a b))))        ;the other diagonal
  40.  
  41. ; Is poistion (n,m) on the board safe for a queen ?
  42. (defun conflict (n m board)
  43.   (cond ((null board) nil)
  44.     ((threat n m (caar board) (cadar board)) t)
  45.     (t (conflict n m (cdr board)))))
  46.  
  47.  
  48. ; Place queens on a board of size SIZE
  49. (defun queens (size)
  50.   (prog (n m board)
  51.     (setq board nil)
  52.     (setq n 1)            ;Try the first row
  53.     loop-n
  54.     (setq m 1)            ;Column 1
  55.     loop-m
  56.     (cond ((conflict n m board) (go un-do-m))) ;Check for conflict
  57.     (setq board (cons (list n m) board))       ; Add queen to board
  58.     (cond ((> (setq n (1+ n)) size)            ; Placed N queens ?
  59.            (print (reverse board))))           ; Print config
  60.     (go loop-n)                       ; Next row which column?
  61.     un-do-n
  62.     (cond ((null board) (return 'Done))        ; Tried all possibilities
  63.           (t (setq m (cadar board))           ; No, Undo last queen placed
  64.          (setq n (caar board))
  65.          (setq board (cdr board))))
  66.  
  67.     un-do-m
  68.     (cond ((> (setq m (1+ m)) size)          ; Go try next column
  69.            (go un-do-n))
  70.           (t (go loop-m)))))
  71.